package TOCInfo;

use strict;
use warnings;

use IO::Dir;
use File::Slurp;

use Constants qw( :suffix :toc :vinfo :svn );
use Options;
use Database;
use FormatString;

BEGIN {
    use Exporter ();
    our ( $VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS );

    $VERSION     = sprintf( "%d", q$Revision$ =~ m{\d+} );
    @ISA         = qw(Exporter);
    @EXPORT      = qw(&generic_get_info);
    %EXPORT_TAGS = ();
    @EXPORT_OK   = qw();
} ## end BEGIN

our %generic_info_cache = ();

# Fields
use constant field_comments => 0;
use constant field_tags     => 1;
use constant field_files    => 2;
use constant field_last_tag => 3;
use constant field_i18n     => 4;
use constant field_name     => 5;

# Functions
sub generic_get_info($ );

# Private methods
sub p_load_raw($$ );

# Methods
sub load_from_path($$ );
sub load($$ );

# Variables
our %toc_cache  = ();
our %comma_tags = (
    &TOC_REQUIRED_DEPENDENCIES         => 1,
    &TOC_OPTIONAL_DEPENDENCIES         => 1,
    &TOC_LOAD_WITH                     => 1,
    &TOC_SAVED_VARIABLES               => 1,
    &TOC_SAVED_VARIABLES_PER_CHARACTER => 1,
    &TOC_EMBEDS                        => 1,
);
our %tag_aliases = (
    "Dependencies" => &TOC_REQUIRED_DEPENDENCIES,
    "Dependancies" => &TOC_REQUIRED_DEPENDENCIES,    # (sic)
);

sub new($$ ) {
    my $this     = shift;
    my $class    = ref( $this ) || $this;
    my $filename = shift;
    my $comments = [];
    my $tags     = {};
    my $files    = {};
    my $self     = [];
    $self->[ &field_comments ] = $comments;
    $self->[ &field_tags ]     = $tags;
    $self->[ &field_files ]    = $files;
    $self->[ &field_last_tag ] = 0;
    $self->[ &field_name ]     = $filename;
    bless $self, $class;
    $self;
} ## end sub new($$ )

sub p_load_raw($$ ) {
    my $self     = shift;
    my $contents = shift;

    my $comments = $self->[ &field_comments ];
    my $tags     = $self->[ &field_tags ];
    my $files    = $self->[ &field_files ];

    my $index    = 0;
    my $last_tag = 0;
    my @lines    = split_lines( $contents );

    foreach ( @lines ) {
        ++$index;
        $self->[ &field_i18n ] = 1 if ( s{^\xEF\xBB\xBF}{} );
        my $line = [ $index, $_ . "\n" ];
        if ( m{^\s*##\s*([^:\s]*):(.*)$} ) {
            my ( $key, $value ) = ( $1, $2 );
            $value =~ s{^\s+}{};
            $value =~ s{\s+$}{};
            my $tag = $tag_aliases{ $key } || $key;
            if ( $tag =~ m{^(X-addonpkg-)svn-(.*)} ) {
                $tag = $1 . $2;
            }
            my $tagrec = ( $tags->{ $tag } ||= [ undef, [] ] );
            if ( $comma_tags{ $tag } ) {
                $tagrec->[ 0 ] ||= [];
                push @{ $tagrec->[ 0 ] }, split( /\s*[;,]\s*/, $value );
            }
            else {
                $tagrec->[ 0 ] = $value;
            }
            push @{ $tagrec->[ 1 ] }, $line;
            $last_tag = $index;
        } ## end if ( m{^\s*##\s*([^:\s]*):(.*)$})
        elsif ( m{^\s*#} ) {
            push @$comments, $line;
        }
        elsif ( m{^\s*$} ) {
        }
        else {
            my $file = $_;
            $file =~ s{^\s+}{};
            $file =~ s{\s+$}{};
            if ( $files->{ $file } ) {
                my $old_file = $files->{ $file };
                push @$old_file, $line;
            }
            else {
                $files->{ $file } = [ $line ];
            }
        } ## end else [ if ( m{^\s*##\s*([^:\s]*):(.*)$})]
    } ## end foreach ( @lines )
    $self->[ &field_last_tag ] = $last_tag;
    return $self;
} ## end sub p_load_raw($$ )

sub load_from_path($$ ) {
    my ( $this, $node_path ) = @_;
    my $class = ref( $this ) || $this;
    return undef unless $node_path;
    my $key = $node_path->get_key;
    return undef unless $key;
    my $self = $toc_cache{ $key };
    return $self if defined $self;
    my $contents = $node_path->get_contents;
    return undef unless defined $contents;
    $self = $class->new( $node_path->get_name );
    $toc_cache{ $key } = $self;
    return $self->p_load_raw( $contents );
} ## end sub load_from_path($$ )

sub load($$ ) {
    my $this  = shift;
    my $class = ref( $this ) || $this;
    my $file  = shift;
    return undef unless $file;
    return $file if ( ref( $file ) && ref( $file ) eq $this );
    return undef unless -r $file;
    my $key = get_file_key( $file );
    return undef unless defined $key;
    my $self = $toc_cache{ $key };
    return $self if defined $self;
    $self = $class->new( path_to_node( $file ) );
    $toc_cache{ $key } = $self;
    my $contents = read_file( $file, binmode => ':raw' );
    return $self->p_load_raw( $contents );
} ## end sub load($$ )

sub extract($ ) {
    my $self = shift;

    my $res   = "";
    my @lines = ();

    # Dump comments
    my $comments = $self->[ &field_comments ];
    push @lines, @$comments;

    # Dump files
    my $files = $self->[ &field_files ];
    my ( $file, $filerec );
    while ( ( $file, $filerec ) = each %$files ) {
        push @lines, @$filerec;
    }

    # Dump headers
    my $tags = $self->[ &field_tags ];
    my ( $tag, $tagrec );
    while ( ( $tag, $tagrec ) = each %$tags ) {
        push @lines, @{ $tagrec->[ 1 ] };
    }

    @lines = sort { $a->[ 0 ] <=> $b->[ 0 ] || $a->[ 1 ] cmp $b->[ 1 ] } @lines;

    my $last = 1;

    $res .= "\xEF\xBB\xBF" if ( $self->[ &field_i18n ] );
    foreach my $line ( @lines ) {
        my $index = $line->[ 0 ];
        if ( $index > $last ) { $res .= "\n" x ( $index - $last ); }
        $last = $index + 1;
        $res .= $line->[ 1 ];
    } ## end foreach my $line ( @lines )

    return $res;
} ## end sub extract($ )

sub get_files($ ) {
    my $self  = shift;
    my $files = $self->[ &field_files ];
    return keys %$files;
}

sub disable_file($$ ) {
    my $self    = shift;
    my $file    = shift;
    my $files   = $self->[ &field_files ];
    my $filerec = $files->{ $file };
    if ( $filerec ) {
        my $comments = $self->[ &field_comments ];
        foreach my $fline ( @$filerec ) {
            push @$comments, [ $fline->[ 0 ], "# " . $fline->[ 1 ] ];
        }
        delete $files->{ $file };
    } ## end if ( $filerec )
} ## end sub disable_file($$ )

sub get_tags($ ) {
    my $self = shift;
    my $tags = $self->[ &field_tags ];
    return keys %$tags;
}

sub get_tag($$ ) {
    my $self   = shift;
    my $key    = shift;
    my $tag    = $tag_aliases{ $key } || $key;
    my $tags   = $self->[ &field_tags ];
    my $tagrec = $tags->{ $tag };
    if ( $comma_tags{ $tag } ) {
        return () unless defined $tagrec;
        return @{ $tagrec->[ 0 ] };
    }
    else {
        return undef unless defined $tagrec;
        return $tagrec->[ 0 ];
    }
} ## end sub get_tag($$ )

sub set_tag($$@ ) {
    my $self   = shift;
    my $key    = shift;
    my $rvalue = join( ", ", @_ );

    my $tag = $tag_aliases{ $key } || $key;

    my $tags = $self->[ &field_tags ];
    my $tagrec = $tags->{ $tag } || [];

    my $line = $tagrec->[ 1 ];
    $line = $line && $line->[ 0 ];
    $line = $line && $line->[ 0 ];
    $line = 1 + $self->[ &field_last_tag ] unless $line;

    if ( $comma_tags{ $tag } ) {
        $tagrec->[ 0 ] = [ @_ ];
        $tagrec->[ 1 ] = [ [ $line, "## " . $tag . ": " . $rvalue . "\n" ] ];
    }
    else {
        unless ( defined $tagrec->[ 0 ] && $tagrec->[ 0 ] eq $rvalue ) {
            $tagrec->[ 0 ] = $rvalue;
            $tagrec->[ 1 ] = [ [ $line, "## " . $tag . ": " . $rvalue . "\n" ] ];
        }
    } ## end else [ if ( $comma_tags{ $tag...})]
    $tags->{ $tag } = $tagrec;
} ## end sub set_tag($$@ )

sub get_embed_rev($$ ) {
    my $self      = shift;
    my $embed_dir = shift;
    my $key       = $embed_dir;
    $key =~ s{[^A-Za-z_0-9.]+}{-}g;
    $key =~ s{^-}{};
    $key =~ s{--+}{-}g;
    $key = &TOC_ADDONPKG_REVISION . "-" . $key;
    return $self->get_tag( $key );
} ## end sub get_embed_rev($$ )

sub set_embed_rev($$$ ) {
    my $self      = shift;
    my $embed_dir = shift;
    my $rev       = shift;
    my $key       = $embed_dir;
    $key =~ s{[^A-Za-z_0-9.]+}{-}g;
    $key =~ s{^-}{};
    $key =~ s{--+}{-}g;
    $key = &TOC_ADDONPKG_REVISION . "-" . $key;
    return $self->set_tag( $key, $rev );
} ## end sub set_embed_rev($$$ )

sub get_name($ ) { $_[ 0 ]->[ &field_name ]; }

# Get generic version control like info
sub generic_get_info($ ) {
    my $path = shift;
    return $path if ref $path;
    my $res;
    return $res unless defined $path;
    my $node = path_to_node( $path );

    my $toc_path = File::Spec->catfile( $path, $node . &SUFFIX_TOC );
    my $key = get_file_key( $toc_path );
    if ( defined $key ) {
        $res = $generic_info_cache{ $key };
        unless ( defined $res ) {
            $res = $generic_info_cache{ $key } = {};
            $res->{ "_KEY_" }          = $key;
            $res->{ &VINFO_REPO_NAME } = $node;
            $res->{ &VINFO_REPO_PATH } = $path;
            my $toc = TOCInfo->load( $toc_path );
            my $toc_okay;
            if ( $toc ) {
                if ( $toc->get_tag( &TOC_ADDONPKG_REVISION ) ) {
                    $res->{ &VINFO_FILE_REVISION } = $res->{ &VINFO_DIR_REVISION } = $res->{ &VINFO_PROJECT_REVISION } = $toc->get_tag( &TOC_ADDONPKG_REVISION );
                    $toc_okay = 1;
                }
                if ( $toc->get_tag( &TOC_ADDONPKG_URL ) ) {
                    $res->{ &VINFO_URL } = $toc->get_tag( &TOC_ADDONPKG_URL );
                    my $normalized_url = unformat_string(
                        $res->{ &VINFO_URL },
                        "name" => $node
                    );
                    $res->{ &SVN_NORMALIZED_URL } = $normalized_url;
                    $toc_okay = 1;
                } ## end if ( $toc->get_tag( &TOC_ADDONPKG_URL...))
            } ## end if ( $toc )
            unless ( $toc_okay ) {
                $res = $generic_info_cache{ $key } = "broken";
            }
        } ## end unless ( defined $res )
        return $res if ref $res;
        undef $res;
    } ## end if ( defined $key )

    if ( -d $path ) {
        my $ctime = ( stat( _ ) )[ 9 ];
        $key = $path . ":" . $ctime;
        unless ( exists $generic_info_cache{ $key } ) {
            my $dirh = new IO::Dir( $path );
            return $generic_info_cache{ $key } = undef unless ( $dirh );
            my $best_revision = 0;
            foreach ( $dirh->read ) {
                if (   m{^Changelog-.*-r(\d+)\.xml$}i
                    || m{^Changelog-.*-r(\d+)\.txt$}i )
                {
                    $best_revision = $1 if $1 > $best_revision;
                }
            } ## end foreach ( $dirh->read )
            $dirh->close;
            undef $dirh;
            return $generic_info_cache{ $key } = undef unless $best_revision;
            $res = $generic_info_cache{ $key } = {};
            $res->{ "_KEY_" }          = $key;
            $res->{ &VINFO_REPO_NAME } = $node;
            $res->{ &VINFO_REPO_PATH } = $path;
            $res->{ &VINFO_FILE_REVISION } = $res->{ &VINFO_DIR_REVISION } = $res->{ &VINFO_PROJECT_REVISION } = $best_revision;
        } ## end unless ( exists $generic_info_cache...)
        $res = $generic_info_cache{ $key } unless defined $res;
    } ## end if ( -d $path )
    return $res;
} ## end sub generic_get_info($ )

1;
